home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Pascal / source / Directory Massager / DirMassage.Pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-03-01  |  5.6 KB  |  203 lines  |  [TEXT/EDIT]

  1. program GenieDir;{November 30,1986;Dec 14,86;Feb22,87}
  2.  USES MacIntf;
  3.       {$L DirMassage/Rsrc}
  4.       {$T 'APPL' 'TMLP'}
  5.  const {menu ids}
  6.   appleMenu = 1000; {DA menu}
  7.   FileMenu = 1001;
  8.   MassMenu = 1002;
  9.   lastMenu = 3;
  10.   dialogHook = nil;
  11.   fileFilter = nil; {for SFroutines}
  12.   numTypes = 1;
  13.   
  14.  var
  15.   done :    boolean;
  16.   finish :    text;    {for output file}
  17.   firstline :    string;    {from input file}
  18.   index :    integer;
  19.   initText :    string;    {prompt}
  20.   item :    array[0..7] of string;
  21.   myMenus :    array[1..lastMenu] of MenuHandle;
  22.   promptString:    string;
  23.   reply:    SFReply;
  24.   secondline :    string;    {from input file}
  25.   typeList:    SFTypeList;
  26.   source :    text;    {input file}
  27.   theDialog:    DialogPtr;
  28.   theEvt:    EventRecord;
  29.   theWindow :    WindowPtr;
  30.   topLeft:    Point;    {for minifinder box}
  31.   
  32. procedure SetUpMenus;
  33.  var
  34.   i : integer;
  35.  begin    {procedure SetUpMenus}
  36.   InitMenus;
  37.   myMenus[1] := GetMenu(appleMenu);
  38.   myMenus[2] := GetMenu(fileMenu);
  39.   myMenus[3] := GetMenu(MassMenu);
  40.   AddResMenu(myMenus[1],'DRVR');
  41.   for i := 1 to lastMenu do
  42.    InsertMenu(myMenus[i],0);
  43.   DrawMenuBar;
  44.  end;    {of procedure SetUpMenus}
  45. procedure SetUpSys;
  46.  begin    {procedure SetUpSys}
  47.   InitGraf(@thePort);
  48.   InitFonts;
  49.   InitWindows;
  50.   TEInit;
  51.   InitDialogs(nil);
  52.   SetEventMask(everyEvent);
  53.   FlushEvents(everyEvent,0);
  54.   SetUpMenus;
  55.   InitCursor;
  56.   done := false;
  57.  end;    {ofprocedure SetUpSys}
  58. Procedure UpdateSys;
  59.  begin    {Procedure UpdateSys}
  60.   SystemTask;
  61.  end;    {Procedure UpdateSys}
  62. procedure QuitFile;
  63.  begin
  64.   done := true;
  65.  end;
  66. procedure find;
  67.  var
  68.   hmm : string;
  69.   yet : boolean;
  70.  begin{procedure find}
  71.   repeat
  72.    yet := false;    {do we have a legit first line?}
  73.    readln(source, firstline);
  74.    if length(firstline) < 4 then    {this isn't it, but let's don't bomb}
  75.     firstline := 'xxxx';
  76.    hmm := copy(firstline,4,1);    {does it look like a serial number?}
  77.    if ((hmm >'/')and(hmm<':')) then
  78.     yet := true;
  79.    if eof(source) then yet := true;
  80.   until yet;
  81.   if eof(source) then
  82.    secondline := '      Desc: lost the description' {so we'll always have a secondline}
  83.   else
  84.    readln(source, secondline);
  85.  end;    {of procedure find}
  86. procedure peel;
  87.  var
  88.   index : integer;
  89.  begin    {procedure peel}
  90.   item[0] := copy(firstline, 1, 6);    {serial number}
  91.   item[1] := copy(firstline, 7, 25);    {name}
  92.   item[2] := copy(firstline, 32, 15);    {type & source}
  93.   item[3] := copy(firstline, 47, 7);    {date}
  94.   item[4] := copy(firstline, 54, 8);    {size}
  95.   item[5] := copy(firstline, 62, 7);    {accesses}
  96.   item[6] := copy(firstline, 69, 3);    {library number}
  97.   item[7] := copy(secondline, 13, length(secondline)); {the Desc: take it all}
  98.   for index := 0 to 7 do
  99.    begin{cut spaces}
  100.    while pos(' ', item[index]) = 1 do
  101.     delete(item[index], 1, 1);
  102.    while (copy(item[index], length(item[index]), 1) = ' ') do
  103.     delete(item[index], length(item[index]), 1);
  104.    end;{of cut spaces}
  105.  end;    {of procedure peel}
  106.  
  107. procedure Massage;
  108.  begin    {procedure Massage}
  109.   promptString:='Which to massage?';    {too bad this doesn't show up in the minifinder box}
  110.   with topLeft do
  111.    begin h:= 20;v:=20 end;
  112.   TypeList[0] := 'TEXT';
  113.   SFGetFile(topLeft,promptString,fileFilter,numTypes,typeList,dialogHook,reply);
  114.   if reply.good then
  115.    begin    {anything to do}
  116.     Reset(source, reply.fName);
  117.     promptString := 'Choose Directory Name';
  118.     initText := concat(reply.fName,'.Dir');
  119.     SFPutFile(topLeft, promptString,initText,dialogHook,reply);      
  120.     rewrite(finish, reply.fName);
  121.     if reply.good then begin    {still something to do}
  122.     while not eof(source) do
  123.      begin    {write an entry}
  124.       find;
  125.       peel;
  126.       for index := 0 to 6 do
  127.        write(finish, item[index],chr(9));    {tab delimit the fields}
  128.       writeln(finish, item[7]);    {CarriageReturn delimit the records}
  129.      end;    {of write an entry}
  130.     close(finish);
  131.     end;    {of still something}
  132.     close(source);
  133.    end;    {of anything to do}
  134.  end;{ofprocedure Massage}
  135. procedure DoAppleMenu(theItem : integer);
  136.  var
  137.   refNum : integer;
  138.   name : Str255;
  139. begin
  140.  if theItem = 1 then
  141.   theItem := Alert(1004, nil)
  142.  else
  143.   begin
  144.    GetItem(myMenus[1], theItem, name);
  145.    refNum := OpenDeskAcc(name);
  146.   end;
  147.  end;    {of procedure DoAppleMenu}
  148. procedure DoFileMenu(theItem : integer);
  149.  begin
  150.   case theItem of
  151.    1 : QuitFile;
  152.    end;    {of case}
  153.   end;    {of procedure DoFileMenu}
  154. procedure DoMassMenu(theItem : integer);
  155.  begin
  156.   case theItem of
  157.    1 : Massage;
  158.   end;    {of case}
  159.  end;    {of procedureDoMassMenu}
  160. procedure SelectMenu(selection : longint);
  161.  begin {procedure SelectMenu}
  162.   case HiWord(selection) of
  163.    appleMenu:    DoAppleMenu(LoWord(selection));
  164.    FileMenu:    DoFileMenu(LoWord(selection));
  165.    MassMenu :    DoMassMenu(LoWord(selection));
  166.   end;
  167.  HiLiteMenu(0);
  168.  end;{of procedure SelectMenu} 
  169. procedure KeyEvent (theKey : char);
  170.  begin
  171.   if BitTst(@theEvt.modifiers, 7) then {check for command key}
  172.    SelectMenu(MenuKey(theKey));
  173.  end;    {of KeyEvent}
  174. procedure WindowUpdate;
  175.  begin    {procedure WindowUpdate}
  176.   theWindow := windowPtr(theEvt.message);
  177.   SetPort(theWindow);
  178.   EraseRect(theWindow^.portRect);
  179.   DrawControls(theWindow);
  180.   DrawGrowIcon(theWindow);
  181.   EndUpdate(theWindow);
  182.  end;    {of procedure WindowUpdate}
  183. procedure WindowActivate;
  184.  begin    {procedure WindowActivate}
  185.   WindowUpdate;
  186.  end;    {of procedure WindowActivate}
  187.  
  188. begin    {main program}
  189.  SetUpSys;
  190.  repeat
  191.   UpdateSys;
  192.   if GetNextEvent(everyEvent,theEvt) then
  193.    case theEvt.what of
  194.     mouseDown: case FindWindow(theEvt.where, theWindow) of
  195.      inMenuBar : SelectMenu(MenuSelect(theEvt.where));
  196.      inSysWindow : SystemClick(theEvt, theWindow);
  197.      end;
  198.     keyDown,autoKey: KeyEvent(Chr(theEvt.message mod 256));
  199.     updateEvt : WindowUpdate;
  200.     activateEvt : WindowActivate;
  201.    end;    {of case theEvt}
  202.   until done;
  203. end.